The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/prgtools/programm.ing/m2gem106.lzh/CRYSTAL1.06/SRC/TOOLBOX/WINDTOOL.MOD

Modula Implementation | 1993-01-29 | 9.5 KB | 494 lines

IMPLEMENTATION MODULE WindTool;

(*
Window Tools.

UK __DATE__ __TIME__
*)

(*IMP_SWITCHES*)

FROM AES      IMPORT IntIn,IntOut,crystal,Integer,TreePtr,ObjectIndex,
                     Version;
FROM WindMgr  IMPORT WindowElement,WindowFunctions,Desk,WFBack,
                     WindUpdate;
FROM PORTAB   IMPORT UNSIGNEDWORD,SIGNEDWORD;
FROM RcMgr    IMPORT GRect,RcIntersect;
FROM GrafTool IMPORT HideMouse,ShowMouse;
FROM SYSTEM   IMPORT ADR;
AES_SYSTEM_IMPORT

IMPORT WindMgr;

#if Seimet
CONST F104 = 068020500H;
      F105 = 069060100H;
#endif

PROCEDURE SetKind(Handle: SIGNEDWORD; Kind: WindowElement);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFKind);
    Array[2]:= CAST(Integer,Kind);
  END;
  crystal(105,6,1,0);
END SetKind;

PROCEDURE SetName(Handle: SIGNEDWORD; VAR Name: ARRAY OF CHAR);
BEGIN
  WITH IntIn DO
    WH:= Handle;
    WF:= ORD(WFName);
    WA:= ADR(Name);
  END;
  crystal(105,6,1,0);
END SetName;

PROCEDURE SetInfo(Handle: SIGNEDWORD; VAR Info: ARRAY OF CHAR);
BEGIN
  WITH IntIn DO
    WH:= Handle;
    WF:= ORD(WFInfo);
    WA:= ADR(Info);
  END;
  crystal(105,6,1,0);
END SetInfo;

PROCEDURE GetWorkXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFWorkXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetWorkXYWH;

PROCEDURE SetCurrXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFCurrXYWH);
    WITH Rect DO
      Array[2]:= GX;
      Array[3]:= GY;
      Array[4]:= GW;
      Array[5]:= GH;
    END;
  END;
  crystal(105,6,1,0);
END SetCurrXYWH;

PROCEDURE GetCurrXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFCurrXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetCurrXYWH;

PROCEDURE GetPrevXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFPrevXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetPrevXYWH;

PROCEDURE GetFullXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFFullXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetFullXYWH;

PROCEDURE SetHSlide(Handle: SIGNEDWORD; Pos: UNSIGNEDWORD);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFHSlide);
    Array[2]:= Pos;
  END;
  crystal(105,6,1,0);
END SetHSlide;

PROCEDURE GetHSlide(Handle: SIGNEDWORD): UNSIGNEDWORD;
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFHSlide);
  END;
  crystal(104,2,5,0);
  RETURN IntOut[1];
END GetHSlide;

PROCEDURE SetVSlide(Handle: SIGNEDWORD; Pos: UNSIGNEDWORD);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFVSlide);
    Array[2]:= Pos;
  END;
  crystal(105,6,1,0);
END SetVSlide;

PROCEDURE GetVSlide(Handle: SIGNEDWORD): UNSIGNEDWORD;
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFVSlide);
  END;
  crystal(104,2,5,0);
  RETURN IntOut[1];
END GetVSlide;

PROCEDURE SetTop(Handle: SIGNEDWORD);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFTop);
  END;
  crystal(105,6,1,0);
END SetTop;

PROCEDURE GetTop(): SIGNEDWORD;
BEGIN
  IntIn.Array[1]:= ORD(WFTop);
  crystal(104,2,5,0);
  RETURN IntOut[1];
END GetTop;

PROCEDURE GetTopAndBelow(VAR Top  : SIGNEDWORD;
                         VAR Id   : SIGNEDWORD;
                         VAR Below: SIGNEDWORD);
BEGIN
  IntIn.Array[1]:= ORD(WFTop);
  crystal(104,2,5,0);
  Top:= IntOut[1];
  Id:= IntOut[2];
  Below:= IntOut[3];
END GetTopAndBelow;

PROCEDURE GetFirstXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFFirstXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetFirstXYWH;

PROCEDURE GetNextXYWH(Handle: SIGNEDWORD; VAR Rect: GRect);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFNextXYWH);
  END;
  crystal(104,2,5,0);
  WITH Rect DO
    GX:= IntOut[1];
    GY:= IntOut[2];
    GW:= IntOut[3];
    GH:= IntOut[4];
  END;
END GetNextXYWH;

PROCEDURE SetNewDesk(PTree: TreePtr; Index: ObjectIndex);
BEGIN
  WITH IntIn DO
    WH:= Desk;
    WF:= ORD(WFNewDesk);
    WA:= PTree;
    WO:= Index;
  END;
  crystal(105,6,1,0);
END SetNewDesk;

PROCEDURE GetNewDesk(): TreePtr;

VAR P: POINTER TO TreePtr;

BEGIN
  IntIn.Array[1]:= ORD(WFNewDesk);
  crystal(104,2,3,0);
  P:= NIL;
  P:= ADR(IntOut);
  RETURN P^;
END GetNewDesk;

PROCEDURE SetHSlSize(Handle: SIGNEDWORD; Size: SIGNEDWORD);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFHSlSize);
    Array[2]:= Size;
  END;
  crystal(105,6,1,0);
END SetHSlSize;

PROCEDURE GetHSlSize(Handle: SIGNEDWORD): SIGNEDWORD;
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFHSlSize);
  END;
  crystal(104,2,5,0);
#if long
  RETURN LONG(IntOut[1]);
#else
  RETURN IntOut[1];
#endif
END GetHSlSize;

PROCEDURE SetVSlSize(Handle: SIGNEDWORD; Size: SIGNEDWORD);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFVSlSize);
    Array[2]:= Size;
  END;
  crystal(105,6,1,0);
END SetVSlSize;

PROCEDURE GetVSlSize(Handle: SIGNEDWORD): SIGNEDWORD;
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WFVSlSize);
  END;
  crystal(104,2,5,0);
#if long
  RETURN LONG(IntOut[1]);
#else
  RETURN IntOut[1];
#endif
END GetVSlSize;

PROCEDURE SetTAttrb(Handle: SIGNEDWORD; IsTop: BOOLEAN);

VAR Ver: UNSIGNEDWORD;

BEGIN
  Ver:= Version();
  IF (Ver = 0220H) OR (Ver = 1042H) THEN
    WITH IntIn DO
      Array[0]:= Handle;
      Array[1]:= ORD(WFTAttrb);
      Array[2]:= ORD(IsTop);
    END;
    crystal(105,6,1,0);
  ELSE
    IntOut[0]:= 0; (* error *)
  END;
END SetTAttrb;

PROCEDURE SetSizTop(Handle: SIGNEDWORD; VAR Rect: GRect);

VAR Ver: UNSIGNEDWORD;

BEGIN
  Ver:= Version();
  IF (Ver = 0220H) OR (Ver = 1042H) THEN
    WITH IntIn DO
      Array[0]:= Handle;
      Array[1]:= ORD(WFSizTop);
      WITH Rect DO
        Array[2]:= GX;
        Array[3]:= GY;
        Array[4]:= GW;
        Array[5]:= GH;
      END;
    END;
    crystal(105,6,1,0);
  ELSE
    IntOut[0]:= 0; (* error *)
  END;
END SetSizTop;

PROCEDURE GetOwner(    Handle: SIGNEDWORD;
                   VAR Open  : BOOLEAN;
                   VAR Above : SIGNEDWORD;
                   VAR Below : SIGNEDWORD): SIGNEDWORD;
BEGIN
  IntIn.Array[0]:= Handle;
  IntIn.Array[1]:= ORD(WindMgr.WFOwner);
  crystal(104,2,4,0);
  Open:= IntOut[2] = 1;
  Above:= IntOut[3];
  Below:= IntOut[4];
  RETURN IntOut[1];
END GetOwner;

PROCEDURE SetBack(Handle: SIGNEDWORD);
BEGIN
  IF Version() = 1042H THEN
    WITH IntIn DO
      Array[0]:= Handle;
      Array[1]:= WFBack;
    END;
    crystal(105,6,1,0);
  ELSE
    IntOut[0]:= 0; (* error *)
  END;
END SetBack;

PROCEDURE SetBEvent(Handle: SIGNEDWORD; OnOff: BOOLEAN);
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WindMgr.WFBEvent);
    Array[2]:= ORD(OnOff);
    Array[3]:= 0;
    Array[4]:= 0;
    Array[5]:= 0;
  END;
  crystal(105,3,0,0);
END SetBEvent;

PROCEDURE GetBEvent(Handle: SIGNEDWORD): BOOLEAN;
BEGIN
  WITH IntIn DO
    Array[0]:= Handle;
    Array[1]:= ORD(WindMgr.WFBEvent);
    Array[2]:= 0;
    Array[3]:= 0;
    Array[4]:= 0;
    Array[5]:= 0;
  END;
  crystal(104,2,2,0);
  RETURN IntOut[1] = 1;
END GetBEvent;

PROCEDURE SetBottom(Handle: SIGNEDWORD);
BEGIN
  IntIn.Array[0]:= Handle;
  IntIn.Array[1]:= ORD(WindMgr.WFBottom);
  crystal(105,2,0,0);
END SetBottom;

PROCEDURE GetBottom(): SIGNEDWORD;
BEGIN
  IntIn.Array[1]:= ORD(WindMgr.WFBottom);
  crystal(104,2,2,0);
  RETURN IntOut[1];
END GetBottom;

PROCEDURE BeginUpdate;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.BegUpdate);
END BeginUpdate;

PROCEDURE EndUpdate;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.EndUpdate);
END EndUpdate;

PROCEDURE ChkUpdate(): BOOLEAN;
BEGIN
  RETURN WindUpdate(WindMgr.ChkUpdate);
END ChkUpdate;

PROCEDURE BeginMouseControl;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.BegMCtrl);
END BeginMouseControl;

PROCEDURE EndMouseControl;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.EndMCtrl);
END EndMouseControl;

PROCEDURE ChkMCtrl(): BOOLEAN;
BEGIN
  RETURN WindUpdate(WindMgr.ChkMCtrl);
END ChkMCtrl;

PROCEDURE BeginEmergency;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.BegEmerg);
END BeginEmergency;

PROCEDURE EndEmergency;

VAR D: BOOLEAN;

BEGIN
  D:= WindUpdate(WindMgr.EndEmerg);
END EndEmergency;

PROCEDURE RedrawWindow(    Window: SIGNEDWORD;
                       VAR Clip  : GRect;
                           Draw  : DrawProc);

VAR Rect: GRect;

BEGIN
  BeginUpdate;
  HideMouse;

  GetFirstXYWH(Window,Rect);
  WITH Rect DO
    WHILE (GW # 0) AND (GH # 0) DO
      IF RcIntersect(Clip,Rect) THEN
        Draw(Rect);
      END;
      GetNextXYWH(Window,Rect);
    END;
  END;

  ShowMouse;
  EndUpdate;
END RedrawWindow;

END WindTool.